home *** CD-ROM | disk | FTP | other *** search
/ Mac Mania 4 / MacMania 4.toast / / Games&Education / ez-genes-02 / Source 0.2 / UFile.p < prev   
Text File  |  1993-04-04  |  8KB  |  384 lines
  1. unit UFile;
  2.  
  3. interface
  4.  
  5.     uses
  6.     { • MacApp }
  7.         SysEqu, Traps, PrintTraps, ULoMem, UMacAppUtilities, UPatch, UObject, UViewCoords, 
  8.  
  9.         UMemory, UFailure;
  10.  
  11.     type
  12.  
  13.         FileUsage = (kDisk, kPermMem, kTempMem, kClipboard);
  14.  
  15.         TGenericFile = object(TObject)
  16.  
  17.                 fref: integer;
  18.                 fSize, fPos: longint;
  19.  
  20.                 procedure TGenericFile.IGenericFile (RefNum: integer);
  21.  
  22.                 function TGenericFile.EndOfFile: Boolean;
  23.  
  24.                 procedure TGenericFile.SetFilePos (N: longint);
  25.  
  26.                 procedure TGenericFile.GetFilePos (var N: longint);
  27.  
  28.                 procedure TGenericFile.Fields (procedure DoToField (fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER));
  29.                 OVERRIDE;
  30.             end;
  31.  
  32.  
  33.         TTextFile = object(TGenericFile)
  34.  
  35.                 fBuffer: handle;
  36.                 fUsage: FileUsage;
  37.  
  38.                 procedure TTextFile.ITextFile (RefNum: integer; usage: FileUsage);
  39.  
  40.                 procedure TTextFile.Free;
  41.                 OVERRIDE;
  42.                 procedure TTextFile.ShallowRead (addr: ptr; var N: longint);    {Private}
  43.  
  44.                 procedure TTextFile.SkipTo (ch: char);
  45.  
  46.                 function TTextFile.NextLine: str255;
  47.  
  48.                 function TTextFile.NextNumber: longint;
  49.  
  50.                 procedure TTextFile.WriteLine (S: str255);
  51.  
  52.                 procedure TTextFile.SetFilePos (N: longint);
  53.                 OVERRIDE;
  54.                 procedure TTextFile.GetFilePos (var N: longint);
  55.                 OVERRIDE;
  56.                 procedure TTextFile.Fields (procedure DoToField (fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER));
  57.                 OVERRIDE;
  58.             end;
  59.  
  60.  
  61.         TRecordFile = object(TGenericFile)
  62.  
  63.                 fRecSize: integer;
  64.  
  65.                 procedure TRecordFile.IRecordFile (RefNum, RecSiz: integer);
  66.  
  67.                 procedure TRecordFile.Seek (N: longint);
  68.  
  69.                 procedure TRecordFile.ReadRec (addr: ptr);
  70.  
  71.                 procedure TRecordFile.WriteRec (addr: ptr);
  72.  
  73.                 procedure TRecordFile.Fields (procedure DoToField (fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER));
  74.                 OVERRIDE;
  75.             end;
  76.  
  77.  
  78.     function TempNewHandle (logicalSize: Size; var resultCode: OSErr): Handle;
  79.     inline
  80.         $3F3C, $001D, $A88F;
  81.  
  82.     procedure TempDisposeHandle (h: Handle; var resultCode: OSErr);
  83.     inline
  84.         $3F3C, $0020, $A88F;
  85.  
  86.  
  87. implementation
  88.  
  89. {$S AFile}
  90.     procedure TGenericFile.IGenericFile (RefNum: integer);
  91.         var
  92.             N: longint;
  93.     begin
  94.         fRef := RefNum;
  95.         FailOSErr(GetEof(fRef, N));
  96.         fSize := N;
  97.         fPos := 0;
  98. {$IFC qDebug}
  99.         writeln('File: ', fSize : 6, fPos : 3);
  100. {$ENDC}
  101.     end;
  102.  
  103.     function TGenericFile.EndOfFile: Boolean;
  104.     begin
  105.         EndOfFile := (fPos >= fSize)
  106.     end;
  107.  
  108.     procedure TGenericFile.SetFilePos (N: longint);
  109.     begin
  110.         FailOSErr(SetFPos(fRef, fsFromStart, N));
  111.         fPos := N
  112.     end;
  113.  
  114.     procedure TGenericFile.GetFilePos (var N: longint);
  115.     begin
  116.         FailOSErr(GetFPos(fRef, N));
  117.         fPos := N
  118.     end;
  119.  
  120.  
  121. {  procedure TTextFile.ITextFile (RefNum: integer; Buffered: Boolean); }
  122. {   var }
  123. {    N: longint; }
  124. {  begin }
  125. {   IGenericFile(RefNum); }
  126. {   N := fSize; }
  127. {   if Buffered then }
  128. {    fBuffer := NewPermHandle(N) }
  129. {   else }
  130. {    fBuffer := nil; }
  131. {   if fBuffer <> nil then }
  132. {    FailOSErr(FSRead(fRef, N, fBuffer^)); }
  133. {  end; }
  134.  
  135.     procedure TTextFile.ITextFile (RefNum: integer; usage: FileUsage);
  136.         var
  137.             N: longint;
  138.             h: Handle;
  139.             offset: LONGINT;
  140.             savedPerm: BOOLEAN;
  141.             err: integer;
  142.     begin
  143.         fUsage := usage;
  144.         fBuffer := nil;
  145.         if usage = kClipboard then
  146.             begin
  147.                 h := NewPermHandle(0);
  148.                 FailNIL(h);
  149.                 savedPerm := PermAllocation(TRUE);
  150.                 N := GetScrap(h, 'TEXT', offset);
  151.                 savedPerm := PermAllocation(savedPerm);
  152.                 if N < 0 then
  153.                     FailOSErr(N);
  154.                 fBuffer := h;
  155.                 fRef := 0;
  156.                 fSize := N;
  157.                 fPos := 0;
  158.             end
  159.         else
  160.             begin
  161.                 IGenericFile(RefNum);
  162.                 N := fSize;
  163.                 case usage of
  164.                     kDisk: 
  165.                         ;
  166.                     kPermMem: 
  167.                         begin
  168.                             fBuffer := NewPermHandle(N);
  169. {$IFC qDebug}
  170.                             writeln('  Perm Buffer: ', MemError, fBuffer <> nil);
  171. {$ENDC}
  172.                         end;
  173.                     kTempMem: 
  174.                         begin
  175.                             if gConfiguration.systemVersion >= $700 then
  176.                                 fBuffer := TempNewHandle(N, err);
  177. {$IFC qDebug}
  178.                             writeln('  Temp Buffer: ', err, '  ', fBuffer <> nil);
  179. {$ENDC}
  180.                         end;
  181.                 end;
  182.                 if fBuffer = nil then
  183.                     fUsage := kDisk
  184.                 else
  185.                     FailOSErr(FSRead(fRef, N, fBuffer^));
  186.             end;
  187.     end;
  188.  
  189.     procedure TTextFile.Free;
  190.         OVERRIDE;
  191.         var
  192.             err: integer;
  193.     begin
  194.         case fUsage of
  195.             kDisk: 
  196.                 ;
  197.             kPermMem, kClipboard: 
  198.                 if fBuffer <> nil then
  199.                     DisposHandle(fBuffer);
  200.             kTempMem: 
  201.                 begin
  202.                     TempDisposeHandle(fBuffer, err);
  203. {$IFC qDebug}
  204.                     writeln('  Disp Buffer: ', err, '  ', fBuffer = nil);
  205. {$ENDC}
  206.                 end;
  207.         end;
  208.         inherited Free;
  209.     end;
  210.  
  211. {  procedure TTextFile.Free; }
  212. {   OVERRIDE; }
  213. {  begin }
  214. {   if fBuffer <> nil then }
  215. {    DisposHandle(fBuffer); }
  216. {   inherited Free; }
  217. {  end; }
  218.  
  219.     procedure TTextFile.ShallowRead (addr: ptr; var N: longint);
  220.     begin
  221.         if fBuffer <> nil then
  222.             begin
  223.                 BlockMove(ptr(ord(fBuffer^) + fPos), addr, N);
  224.             end
  225.         else
  226.             begin
  227.                 FailOSErr(FSRead(fRef, N, addr));
  228.             end;
  229.         SetFilePos(fPos + N);
  230.     end;
  231.  
  232.     procedure TTextFile.SkipTo (ch: char);
  233.         var
  234.             S: str255;
  235.             N, p: longint;
  236.             k: integer;
  237.     begin
  238.         repeat
  239.             N := min(fSize - fPos, 255);
  240.             p := fPos;
  241.             ShallowRead(@S[1], N);
  242.             k := 0;
  243.             repeat
  244.                 k := k + 1
  245.             until (S[k] = ch) or (k = N);
  246.         until (S[k] = ch) or EndOfFile;
  247.         SetFilePos(p + k);
  248.     end;
  249.  
  250.     function TTextFile.NextLine: str255;
  251.         var
  252.             S: str255;
  253.             k, p1, p2: longint;
  254.     begin
  255.         p1 := fPos;
  256.         SkipTo(chReturn);
  257.         p2 := fPos;
  258.         k := min(p2 - p1 - 1, 255);
  259.         if k > 0 then
  260.             begin
  261.                 SetFilePos(p1);
  262.                 ShallowRead(@S[1], k);
  263.             end;
  264.         S[0] := chr(k);
  265.         NextLine := S;
  266.         SetFilePos(p2);
  267.     end;
  268.  
  269.     function TTextFile.NextNumber: longint;
  270.         var
  271.             X: str255;
  272.             k: integer;
  273.             p, N: longint;
  274.     begin
  275.         p := fPos;
  276.         X := NextLine;
  277.         k := 1;
  278.         while (k < length(X)) & (X[k] in [' ', chTab]) do
  279.             k := k + 1;
  280.         while (k < length(X)) & (X[k] in ['0'..'9']) do
  281.             k := k + 1;
  282.         X[0] := chr(k - 1);
  283.         if k > 1 then
  284.             StringToNum(X, N)
  285.         else
  286.             N := 0;
  287.         NextNumber := N;
  288.         SetFilePos(p + k - 1);
  289.     end;
  290.  
  291.     procedure TTextFile.WriteLine (S: str255);
  292.         var
  293.             N: longint;
  294.     begin
  295.         if fBuffer <> nil then
  296.             FailOSErr(111);
  297.         N := length(S);
  298.         FailOSErr(FSWrite(fRef, N, @S[1]));
  299.         N := 1;
  300.         S[1] := chReturn;
  301.         FailOSErr(FSWrite(fRef, N, @S[1]));
  302.         GetFilePos(N);
  303.         fSize := N
  304.     end;
  305.  
  306.     procedure TTextFile.SetFilePos (N: longint);
  307.         OVERRIDE;
  308.     begin
  309.         if fBuffer <> nil then
  310.             fPos := min(N, fSize)
  311.         else
  312.             inherited SetFilePos(N);
  313.     end;
  314.  
  315.     procedure TTextFile.GetFilePos (var N: longint);
  316.         OVERRIDE;
  317.     begin
  318.         if fBuffer <> nil then
  319.             N := fPos
  320.         else
  321.             inherited GetFilePos(N);
  322.     end;
  323.  
  324.  
  325.     procedure TRecordFile.IRecordFile (RefNum, RecSiz: integer);
  326.     begin
  327.         IGenericFile(RefNum);
  328.         fRecSize := RecSiz;
  329.         FailOSErr(fSize mod fRecSize);    {File size must be a multiple of record size}
  330.     end;
  331.  
  332.     procedure TRecordFile.Seek (N: longint);
  333.     begin
  334.         SetFilePos(N * fRecSize);
  335.     end;
  336.  
  337.     procedure TRecordFile.ReadRec (addr: ptr);
  338.         var
  339.             N: longint;
  340.     begin
  341.         N := fRecSize;
  342.         FailOSErr(FSRead(fRef, N, addr));
  343.         fPos := fPos + N
  344.     end;
  345.  
  346.     procedure TRecordFile.WriteRec (addr: ptr);
  347.         var
  348.             N: longint;
  349.     begin
  350.         N := fRecSize;
  351.         FailOSErr(FSWrite(fRef, N, addr));
  352.         if EndOfFile then
  353.             fSize := fSize + N;
  354.         fPos := fPos + N
  355.     end;
  356.  
  357. {$S AFields}
  358.     procedure TGenericFile.Fields (procedure DoToField (fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER));
  359.         OVERRIDE;
  360.     begin
  361.         DoToField('TGenericFile', nil, bClass);
  362.         DoToField('fRef', @fRef, bINTEGER);
  363.         DoToField('fSize', @fSize, bLongint);
  364.         DoToField('fPos', @fPos, bLongint);
  365.         inherited Fields(DoToField);
  366.     end;
  367.  
  368.     procedure TTextFile.Fields (procedure DoToField (fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER));
  369.         OVERRIDE;
  370.     begin
  371.         DoToField('TTextFile', nil, bClass);
  372.         DoToField('fBuffer', @fBuffer, bHandle);
  373.         inherited Fields(DoToField);
  374.     end;
  375.  
  376.     procedure TRecordFile.Fields (procedure DoToField (fieldName: Str255; fieldAddr: Ptr; fieldType: INTEGER));
  377.         OVERRIDE;
  378.     begin
  379.         DoToField('TRecordFile', nil, bClass);
  380.         DoToField('fRecSize', @fRecSize, bLongint);
  381.         inherited Fields(DoToField);
  382.     end;
  383.  
  384. end.